home *** CD-ROM | disk | FTP | other *** search
- #! /usr/bin/perl -w
- # $Id: cups-genppdupdate.in,v 1.57 2009/06/07 02:34:55 rlk Exp $
- # Update CUPS PPDs for Gutenprint queues.
- # Copyright (C) 2002-2003 Roger Leigh (rleigh@debian.org)
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2, or (at your option)
- # any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program; if not, write to the Free Software
- # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
- use strict;
- use Getopt::Std;
- use Fcntl qw(:mode);
- use FileHandle;
- use IPC::Open2;
-
- sub parse_options ();
- sub get_driver_version ();
- sub update_ppd ($); # Original PPD filename
- sub get_ppd_fh ($$$$$); # Return contents of desired PPD
- sub find_ppd ($$$$); # Gutenprint Filename, driver, language (e.g. en, sv),
- # region (e.g. GB, DE)
- sub get_ppd_data (*$$$$$); # Source PPD FH
-
- our $opt_d; # Debug mode
- our $opt_h; # Help
- our $opt_n; # No action
- our $opt_q; # Quiet mode
- our $opt_s; # Source PPD location
- our $opt_p; # New PPD location
- our $opt_P; # PPD generator location
- our $opt_v; # Verbose mode
- our $opt_N; # Don't update PPD file options
- our $opt_o; # Output directory
- our $opt_r; # Gutenprint version
- our $opt_i; # Interactive
- our $opt_f; # Force upgrade
- our $opt_l; # Language
-
- my $debug = 0;
- my $verbose = 0; # Verbose output
- my $interactive = 0;
- my $quiet = 0; # No output
- my $no_action = 0; # Don't output files
- my $reset_defaults = 0; # Reset options to default settings
- my $version = "5.2";
- my $micro_version = "5.2.4";
- my $use_static_ppd = "no";
- my $file_version = '"5.2.4"$';
-
- my $ppd_dir = "/etc/cups/ppd"; # Location of in-use CUPS PPDs
- my $ppd_root_dir = "/usr/share/ppd";
- my $ppd_base_dir = "$ppd_root_dir/gutenprint/$version"; # Available PPDs
- my $ppd_out_dir = ""; # By default output into source directory
- my $gzext = ".gz";
- my $updated_ppd_count = 0;
- my $skipped_ppd_count = 0;
- my $failed_ppd_count = 0;
- my $exit_after_parse_args = 0;
- my @languages = qw(Global C cs da de el en_GB es fr hu it ja nb nl pl pt ru sk sv zh_TW);
-
- my $serverdir = "/usr/lib/cups";
- my $driver_bin = "$serverdir/driver/gutenprint.$version";
- my $driver_version = "";
- my $server_multicat = 0;
- my $server_multicat_initialized = 0;
-
- if (-x $driver_bin) {
- get_driver_version();
- }
-
- $Getopt::Std::STANDARD_HELP_VERSION = 1;
-
- my @ppd_files; # A list of in-use Gutenprint PPD files
-
- # Used to convert a language name to its two letter code
- my %languagemappings = (
- "chinese" => "cn",
- "danish" => "da",
- "dutch" => "nl",
- "english" => "en",
- "finnish" => "fi",
- "french" => "fr",
- "german" => "de",
- "greek" => "el",
- "hungarian" => "hu",
- "italian" => "it",
- "japanese" => "jp",
- "norwegian" => "no",
- "polish" => "pl",
- "portuguese" => "pt",
- "russian" => "ru",
- "slovak" => "sk",
- "spanish" => "es",
- "swedish" => "sv",
- "turkish" => "tr"
- );
-
-
- # Check command-line options...
-
- parse_options();
-
-
- # Set a secure umask...
-
- umask 0177;
-
-
- # Find all in-use Gutenprint PPD files...
- # For case-insensitive filesystems, use only one of .ppd and .PPD
- # (bug 1929738).
-
- if (@ARGV) {
- my $f;
- foreach $f (@ARGV) {
- if (-f $f and ($f =~ /\.ppd$/i or $f =~ /\//)) {
- if (-f $f) {
- push @ppd_files, $f;
- } else {
- print STDERR "Cannot find file $f\n";
- }
- } elsif (-f "$ppd_dir/$f" or
- -f "$ppd_dir/$f.ppd" or
- -f "$ppd_dir/$f.PPD") {
- if (-f "$ppd_dir/$f") {
- push @ppd_files, "$ppd_dir/$f";
- } elsif (-f "$ppd_dir/$f.ppd") {
- push @ppd_files, "$ppd_dir/$f.ppd";
- } elsif (-f "$ppd_dir/$f.PPD") {
- push @ppd_files, "$ppd_dir/$f.PPD";
- }
- } else {
- print STDERR "Cannot find file $ppd_dir/$f, $ppd_dir/$f.ppd, or $ppd_dir/$f.PPD\n";
- }
- }
- } else {
- my @ppdtmp = glob("$ppd_dir/*.{ppd,PPD}");
- my (%ppd_map);
- map { $ppd_map{$_} = 1 } @ppd_files;
- foreach my $f (@ppdtmp) {
- if ($f =~ /\.PPD$/) {
- my ($g) = $f;
- $g =~ s/\.PPD$/.ppd/;
- if (! $ppd_map{$g}) {
- push @ppd_files, $f;
- }
- } else {
- push @ppd_files, $f;
- }
- }
- }
-
- # Update each of the Gutenprint PPDs, where possible...
-
- foreach (@ppd_files) {
- my ($status) = update_ppd($_);
- last if ($status == -2);
- $failed_ppd_count++ if ($status == 0);
- $updated_ppd_count++ if ($status == 1);
- $skipped_ppd_count++ if ($status == -1);
- }
-
- if (!$quiet || $verbose) {
- if (!@ppd_files) {
- print STDOUT "No Gutenprint PPD files to update.\n";
- } elsif ($updated_ppd_count > 0) {
- my $plural = $updated_ppd_count == 1 ? "" : "s";
- print STDOUT "Updated $updated_ppd_count PPD file${plural}.";
- if (!defined $opt_o || $opt_o ne "") {
- print STDOUT "Restart cupsd for the changes to take effect.";
- }
- print STDOUT "\n";
- } else {
- if ($failed_ppd_count > 0) {
- print STDOUT "Failed to update any PPD files\n";
- } else {
- print STDOUT "Did not update any PPD files\n";
- }
- }
- }
- exit ($failed_ppd_count > 0);
-
- sub HELP_MESSAGE($;$$$) {
- my ($fh) = @_;
- print $fh "Usage: $0 [OPTION]... [PPD_FILE]...\n";
- print $fh "Update CUPS+Gutenprint PPD files.\n\n";
- print $fh " -d flags Enable debugging\n";
- print $fh " -h Display this help text\n";
- print $fh " -n No-action. Don't overwrite any PPD files.\n";
- print $fh " -q Quiet mode. No messages except errors.\n";
- print $fh " -s ppd_dir Use ppd_dir as the source PPD directory.\n";
- print $fh " -p ppd_dir Update PPD files in ppd_dir.\n";
- print $fh " -P driver Use the specified driver binary to generate PPD files.\n";
- print $fh " -v Verbose messages.\n";
- print $fh " -N Reset options to defaults.\n";
- print $fh " -o out_dir Output PPD files to out_dir.\n";
- print $fh " -r version Use PPD files for Gutenprint major.minor version.\n";
- print $fh " -f Ignore new PPD file safety checks.\n";
- print $fh " -i Prompt (interactively) for each PPD file.\n";
- print $fh " -l language Language choice (Gutenprint 5.1 or below).\n";
- print $fh " Choices: " . join(" ", @languages) . "\n";
- print $fh " Or -loriginal to preserve original language\n";
- print $fh " with Gutenprint 5.2 or above\n";
- exit(0);
- }
-
- # Getopt::Std calls VERSION_MESSAGE followed by HELP_MESSAGE if --help
- # is passed. If --version is passed, it calls only VERSION_MESSAGE.
- # So we have to make sure to exit, but we want to allow --help to
- # print out the help message.
- sub VERSION_MESSAGE($;$$$) {
- my ($fh) = @_;
- print "cups-genppdupdate from Gutenprint $micro_version\n";
- $exit_after_parse_args = 1;
- }
-
- sub help() {
- HELP_MESSAGE(\*STDOUT);
- }
-
- sub check_multicat() {
- }
-
- sub get_driver_version() {
- open(DBIN, "$driver_bin org.gutenprint.extensions 2>/dev/null |") or return 0;
- my ($line);
- $server_multicat = 0;
- while ($line = <DBIN>) {
- if ($line =~ /^org.gutenprint.multicat$/) {
- $server_multicat = 1;
- last;
- }
- }
- close DBIN;
- $driver_version = `$driver_bin VERSION`;
- chomp $driver_version;
- }
-
- sub parse_options () {
- if (!getopts('d:hnqs:vNo:p:P:r:ifl:')) {
- help();
- }
- if ($opt_n) {
- $no_action = 1;
- }
- if ($opt_d) {
- $debug = $opt_d;
- }
- if ($opt_v) {
- $verbose = 1;
- $quiet = 0;
- }
- if ($opt_q) {
- $verbose = 0;
- $quiet = 1;
- }
- if ($opt_N) {
- $reset_defaults = 1;
- }
- if ($opt_o) {
- if (-d $opt_o) {
- $ppd_out_dir = "$opt_o";
- }
- else {
- die "$opt_o: invalid directory: $!\n";
- }
- }
- if ($opt_r) {
- if ($version ne $opt_r) {
- $version = $opt_r;
- if ($opt_s) {
- if (-d $opt_s) {
- $ppd_base_dir = "$opt_s";
- $driver_bin = "";
- $server_multicat = 0;
- $use_static_ppd = "yes";
- } else {
- die "$opt_s: invalid directory: $!\n";
- }
- } else {
- $ppd_base_dir = "$ppd_root_dir/gutenprint/$version";
- $driver_bin = "$serverdir/driver/gutenprint.$version";
- }
- $driver_version = "";
- # If user specifies version, we're not going to be able to check
- # for an exact match.
- $file_version = "\"$version";
- if (-x $driver_bin) {
- get_driver_version();
- $use_static_ppd = "no";
- $file_version = "\"$driver_version\"\$";
- } elsif (! -d $ppd_base_dir && ! -l $ppd_base_dir) {
- die "Gutenprint $version does not appear to be installed!\n";
- }
- }
- }
- if ($opt_s) {
- if (-d $opt_s) {
- $ppd_base_dir = "$opt_s";
- $driver_bin = "";
- $server_multicat = 0;
- $driver_version = "";
- $use_static_ppd = "yes";
- }
- else {
- die "$opt_s: invalid directory: $!\n";
- }
- }
- if ($opt_p) {
- if (-d $opt_p) {
- $ppd_dir = "$opt_p";
- }
- else {
- die "$opt_p: invalid directory: $!\n";
- }
- }
- if ($opt_P) {
- if (-x $opt_P) {
- $driver_bin = "$opt_P";
- get_driver_version();
- $use_static_ppd = "no";
- }
- else {
- die "$opt_P: invalid executable: $!\n";
- }
- }
- if ($opt_h) {
- help();
- }
- if ($opt_l && lc $opt_l ne "original" && ! grep { $_ eq $opt_l } @languages) {
- print STDERR "Unknown language '$opt_l'\n";
- help();
- }
- if ($opt_i) {
- $interactive = 1;
- }
- if ($exit_after_parse_args) {
- exit(0);
- }
- if ($verbose && $driver_version ne "") {
- print STDOUT "Updating PPD files from Gutenprint $driver_version\n";
- }
- }
-
- sub get_ppd_fh($$$$$) {
- my ($ppd_source_filename, $filename, $driver, $locale, $region) = @_;
-
- my $source_data;
- my ($new_ppd_filename);
-
- if ($use_static_ppd eq "no" && $driver_version ne "") {
- my ($simplified);
- if ($filename =~ m,.*/([^/]*)(.sim)(.ppd)?(.gz)?$,) {
- $simplified = "simple";
- } else {
- $simplified = "expert";
- }
- my ($url);
- my (@url_list);
- if (((defined $opt_r && $opt_r < 5.2) ||
- (defined $opt_l && $opt_l ne "")) &&
- $locale ne "") {
- if ($region) {
- push @url_list, "gutenprint.$version://$driver/$simplified/${locale}_${region}";
- }
- push @url_list, "gutenprint.$version://$driver/$simplified/${locale}";
- }
- push @url_list, "gutenprint.$version://$driver/$simplified";
- foreach $url (@url_list) {
- $new_ppd_filename = $url;
- if ($debug & 8) {
- print "Trying ", (! $server_multicat ? "$driver_bin cat " : ""), "$url for $driver, $simplified, $locale, $region\n";
- }
- if ($server_multicat) {
- if (! $server_multicat_initialized) {
- my ($pid) = open2(*Reader, *Writer, "$driver_bin org.gutenprint.multicat");
- $server_multicat_initialized = 1;
- }
- print Writer "$url\n";
- return ($new_ppd_filename, \*Reader);
- }
- if (open PPD, "$driver_bin cat $url |") {
- return ($new_ppd_filename, \*PPD);
- }
- }
- # Otherwise fall through and try to find a static PPD
- }
-
- # Search for a PPD matching our criteria...
-
- $new_ppd_filename = find_ppd($filename, $driver, $locale, $region);
- if (!defined($new_ppd_filename)) {
- # There wasn't a valid source PPD file, so give up.
- print STDERR "$ppd_source_filename: no valid candidate for replacement. Skipping\n";
- print STDERR "$ppd_source_filename: please upgrade this PPD manually\n";
- return ("", undef);
- }
- if ($debug & 1) {
- print "Candidate PPD: $new_ppd_filename\n";
- }
-
- my $suffix = "\\" . $gzext; # Add '\', so m// matches the '.'.
- if ($new_ppd_filename =~ m/.gz$/) { # Decompress input buffer
- open GZIN, "gunzip -c $new_ppd_filename |"
- or die "$_: can't open for decompression: $!";
- return ($new_ppd_filename, \*GZIN);
- } else {
- open SOURCE, $new_ppd_filename
- or die "$new_ppd_filename: can't open source file: $!";
- binmode SOURCE;
- return ($new_ppd_filename, \*SOURCE);
- }
- }
-
- # Update the named PPD file.
- sub update_ppd ($) {
- my $ppd_source_filename = $_;
- my $ppd_dest_filename = $ppd_source_filename;
- if ($ppd_out_dir) {
- $ppd_dest_filename =~ s;(.*)/([^/]+);$2;;
- $ppd_dest_filename = "$ppd_out_dir/$ppd_dest_filename";
- }
-
- open ORIG, $_ or die "$_: can't open PPD file: $!";
- seek (ORIG, 0, 0) or die "can't seek to start of PPD file: $!";
- my @orig_metadata = stat(ORIG);
- if ($debug & 1) {
- print "Source Filename: $ppd_source_filename\n";
- }
- my ($filename) = "";
- my ($driver) = "";
- my ($gutenprintdriver) = "";
- my ($locale) = "";
- my ($lingo) = "";
- my ($region) = "";
- my ($valid) = 0;
- my ($orig_locale) = "";
- while (<ORIG>) {
- if (/\*StpLocale:/) {
- ($locale) = m/^\*StpLocale:\s*\"(.*)\"$/;
- $orig_locale = $locale;
- $valid = 1;
- } elsif (/^\*LanguageVersion/) {
- ($lingo) = m/^\*LanguageVersion:\s*(.*)$/;
- } elsif (/^\*StpDriverName:/ ) {
- ($driver) = m/^\*StpDriverName:\s*\"(.*)\"$/;
- $valid = 1;
- } elsif (/\*%End of / && $driver eq "") {
- ($driver) = m/^\*%End of\s*(.*).ppd$/;
- } elsif (/^\*StpPPDLocation:/ ) {
- ($filename) = m/^\*StpPPDLocation:\s*\"(.*)\"$/;
- $valid = 1;
- } elsif (/^\*%Gutenprint Filename:/) {
- $valid = 1;
- }
- if ($filename and $driver and $lingo and $locale) {
- last;
- }
- if (! $valid && /^\*OpenUI/) {
- last;
- }
- }
- if (! $valid) {
- # print STDERR "Skipping $ppd_source_filename: not a Gutenprint PPD file\n";
- return -1;
- }
- if (defined $opt_l && $opt_l ne "" && lc $opt_l ne "original") {
- $locale = $opt_l;
- $orig_locale = $locale;
- }
- if ($debug & 2) {
- print "Gutenprint Filename: $filename\n";
- if ($opt_l) {
- print "Locale: $locale (from -l)\n";
- } else {
- print "Locale: $locale\n";
- }
- print "Language: $lingo\n";
- print "Driver: $driver\n";
- }
- if ($locale) {
- # Split into the language and territory.
- ($locale, $region) = split(/_/, $locale);
- } else {
- # Split into the language and territory.
- ($locale, $region) = split(/_/, $lingo);
- # Convert language into language code.
- $locale = $languagemappings{"\L$lingo"};
- if (!defined($locale)) {
- $locale = "C"; # Fallback if there isn't one.
- }
- }
- if (! defined($region)) {
- $region = "";
- }
- if ($debug & 2) {
- print "Base Locale: $locale\n";
- print "Region: $region\n";
- }
-
- # Read in the new PPD, decompressing it if needed...
-
- my ($new_ppd_filename, $source_fd) =
- get_ppd_fh($ppd_source_filename, $filename, $driver, $locale, $region);
-
- if (! defined $source_fd) {
- print "Unable to retrieve PPD file!\n";
- return 0;
- }
-
- if ($interactive) {
- print "Update PPD $ppd_source_filename from $new_ppd_filename [nyq]? ";
- my $input = readline(*STDIN);
- if ($input =~ /^q/i) {
- close $source_fd if !$server_multicat;
- print "Skipping all...\n";
- return -2;
- } elsif (! ($input =~ /^y/i)) {
- close $source_fd if !$server_multicat;
- print "Skipping...\n";
- return -1;
- }
- }
-
- # Extract the default values from the original PPD...
-
- seek(ORIG, 0, 0);
-
- my ($odt, $oopt, $ores, $odef) = get_ppd_data(ORIG, 1, 0, 1, 1, 0);
- my ($ndt, $nopt, $nres, $ndef, $source_data) = get_ppd_data($source_fd, 1, 1, 1, 1, 1);
-
- # Close original and temporary files...
-
- close ORIG;
- if (! $server_multicat && ! close $source_fd) {
- print "Unable to retrieve new PPD file: $!\n";
- return 0;
- }
-
- my %orig_default_types = %$odt;
- my %new_default_types = %$ndt;
- my %defaults = %$odef;
- my %new_defaults = %$ndef;
- my %options = %$nopt;
- my %resolution_map = %$nres;
- my %old_resolution_map = reverse %$ores;
-
- # Store previous language in the PPD file so that -l original works
- # correctly.
-
- if ($orig_locale ne "") {
- $source_data =~ s/(\*StpLocale:\s*\")(.*)(\")/$1$orig_locale$3/;
- }
-
- if ($debug & 4) {
- print "Options (Old->New Default Type):\n";
- foreach (sort keys %options) {
- my ($old_type) = $orig_default_types{$_};
- my ($new_type) = $new_default_types{$_};
- if (! defined($old_type)) {
- $old_type = '(New)';
- }
- if ($old_type ne $new_type) {
- print " $_ ($old_type -> $new_type) : ";
- } else {
- print " $_ ($new_type) : ";
- }
- my ($def) = $defaults{"Default$_"};
- foreach my $opt (@{$options{$_}}) {
- if (defined $def && $def eq $opt) {
- print "*";
- }
- print "$opt ";
- }
- print "\n";
- }
- if (keys %resolution_map) {
- print "Resolution Map:\n";
- foreach (sort keys %resolution_map) {
- print " $_: $resolution_map{$_}\n";
- }
- }
- if (keys %old_resolution_map) {
- print "Old Resolution Map:\n";
- foreach (sort keys %old_resolution_map) {
- print " $_: $old_resolution_map{$_}\n";
- }
- }
- print "Non-UI Defaults:\n";
- foreach (sort keys %defaults) {
- my ($xkey) = $_;
- $xkey =~ s/^Default//;
- if (! defined ($options{$xkey})) {
- print " $_: $defaults{$_}\n";
- }
- }
- print "Default Types of dropped options:\n";
- foreach (sort keys %orig_default_types) {
- if (! defined($options{$_})) {
- print " $_: $orig_default_types{$_}\n";
- }
- }
- }
-
- if ($no_action) {
- if (!$quiet || $verbose) {
- if ($ppd_dest_filename eq $ppd_source_filename) {
- print STDOUT "Would update $ppd_source_filename using $new_ppd_filename\n";
- } else {
- print STDOUT "Would update $ppd_source_filename to $ppd_dest_filename using $new_ppd_filename\n";
- }
- }
- return 0;
- }
-
- if (! $reset_defaults) {
- # Update source buffer with old defaults...
-
- # Loop through each default in turn.
- default_loop:
- foreach my $default_option (sort keys %defaults) {
- my $option;
- my $default_option_value = $defaults{$default_option};
- ($option = $default_option) =~ s/Default//; # Strip off `Default'
- # Check method is valid
- my $orig_method = $orig_default_types{$option};
- my $new_method = $new_default_types{$option};
- my $new_default = $new_defaults{$default_option};
- if ((!defined($orig_method) || !defined($new_method)) ||
- $orig_method ne $new_method) {
- next;
- }
- if (defined($new_default) &&
- $default_option_value eq $new_default) {
- if ($verbose) {
- print "$ppd_source_filename: Preserve *$default_option ($default_option_value)\n";
- }
- next;
- }
- if ($new_method eq "PickOne") {
- # Check the old setting is valid
- foreach my $opt (@{$options{$option}}) {
- my $def_option = $default_option_value;
- my $odef_option = $def_option;
- if ($option eq "Resolution" &&
- defined $old_resolution_map{$def_option}) {
- if ($debug & 4) {
- print "Intermapping old resolution $def_option to $old_resolution_map{$def_option}\n";
- }
- $def_option = $old_resolution_map{$def_option};
- }
- my @dopts = ($def_option);
- if ($def_option ne $odef_option) {
- push @dopts, $odef_option;
- }
-
- foreach my $dopt (@dopts) {
- if (($dopt eq $opt) ||
- ($option eq "Resolution" &&
- (defined $resolution_map{$dopt}) &&
- ($dopt = $resolution_map{$dopt}) eq $opt)) { # Valid option
- # Set the option in the new PPD
- $source_data =~ s/^\*($default_option).*/*$1:$dopt/m;
- if ($verbose) {
- print "$ppd_source_filename: Set *$default_option to $dopt\n";
- }
- next default_loop;
- }
- }
- }
- warn "Warning: $ppd_source_filename: Invalid option: *$default_option: $defaults{$default_option}. Using default setting $new_defaults{$default_option}.\n";
- next;
- }
- warn "Warning: $ppd_source_filename: PPD OpenUI method $new_default_types{$default_option} not understood.\n";
- }
- }
-
- # Write new PPD...
-
- my $tmpnew = "${ppd_dest_filename}.new";
- if (! open NEWPPD, "> $tmpnew") {
- warn "Can't create $tmpnew: $!\n";
- return 0;
- }
- print NEWPPD $source_data;
- if (! close NEWPPD) {
- warn "Can't write to $tmpnew: $!\n";
- unlink $tmpnew;
- return 0;
- }
-
- if (! rename $tmpnew, $ppd_dest_filename) {
- warn "Can't rename $tmpnew to $ppd_dest_filename: $!\n";
- unlink $tmpnew;
- return 0;
- }
- chown($orig_metadata[4], $orig_metadata[5], $ppd_dest_filename);
- chmod(($orig_metadata[2] & 0777), $ppd_dest_filename);
-
- if (!$quiet || $verbose) {
- if ($ppd_dest_filename eq $ppd_source_filename) {
- print STDOUT "Updated $ppd_source_filename using $new_ppd_filename\n";
- } else {
- print STDOUT "Updated $ppd_source_filename to $ppd_dest_filename using $new_ppd_filename\n";
- }
- }
- return 1;
- # All done!
- }
-
- # Find a suitable source PPD file
- sub find_ppd ($$$$) {
- my($gutenprintfilename, $drivername, $lang, $region) = @_;
- my $file; # filename to return
- my ($key) = '^\\*FileVersion:[ ]*' . "$file_version";
- my ($lingo, $suffix, $base, $basedir);
- my ($current_best_file, $current_best_time);
- my ($stored_name, $stored_dir, $simplified);
- $stored_name = $gutenprintfilename;
- $stored_name =~ s,.*/([^/]+\.[0-9]+\.[0-9]+)(\.sim)?(\.ppd)?(\.gz)?$,$1,;
- if ($gutenprintfilename =~ m,.*/([^/]*)(\.sim)(\.ppd)?(\.gz)?$,) {
- $simplified = ".sim";
- } else {
- $simplified = "";
- }
- $stored_dir = $gutenprintfilename;
- $stored_dir =~ s,(.*)/([^/]*)$,$1,;
-
- $current_best_file = "";
- $current_best_time = 0;
- my (@basedirs);
- if ($opt_s) {
- @basedirs = ($opt_s);
- } else {
- @basedirs = ($ppd_base_dir, $stored_dir, $ppd_root_dir);
- }
-
- my (@lingos);
- if ($region ne "") {
- push @lingos, "${lang}_${region}/";
- }
- push @lingos, "$lang/";
- if ($lang ne "C") {
- push @lingos, "C/";
- }
- push @lingos, "en/", "";
- push @lingos, "Global/";
- my (@bases);
- push @bases, "stp-${drivername}.$version${simplified}";
- push @bases, "${drivername}.$version${simplified}";
- if ($stored_name ne "${drivername}.$version${simplified}" and
- $stored_name ne "stp-${drivername}.$version${simplified}") {
- push @bases, $stored_name;
- }
- push @bases, $drivername;
-
- # All possible candidates, in order of usefulness and gzippedness
- foreach $lingo (@lingos) {
- foreach $suffix (".ppd$gzext",
- ".ppd") {
- foreach $base (@bases) {
- foreach $basedir (@basedirs) {
- if ($basedir eq "" || $base eq "") { next; }
- my ($fn) = "$basedir/$lingo$base$suffix";
- if ($debug & 8) {
- print "Trying $fn for $gutenprintfilename, $lang, $region\n";
- }
- # Check that it is a regular file, owned by root.root, not writable
- # by other, and is readable by root. i.e. the file is secure.
- my @sb = stat $fn or next;
- if ($debug & 8) {
- print " Candidate $fn for $gutenprintfilename, $lang, $region\n";
- }
- if ($opt_f || (S_ISREG($sb[2]) && ($sb[4] == 0))) {
- # Check that the file is a valid Gutenprint PPD file
- # of the correct version.
- my $new_file_version;
- if ($fn =~ m/\.gz$/) {
- $new_file_version = `gunzip -c $fn | grep '$key'`;
- } else {
- $new_file_version = `cat $fn | grep '$key'`;
- }
- if ($new_file_version ne "") {
- if ($debug & 8) {
- print " Format valid: time $sb[9] best $current_best_time prev $current_best_file cur $fn!\n";
- }
- if ($sb[9] > $current_best_time) {
- $current_best_time = $sb[9];
- $current_best_file = $fn;
- if ($debug & 8) {
- print STDERR "***current_best_file is $fn\n";
- }
- }
- } elsif ($debug & 8) {
- print " Format invalid\n";
- }
- }
- else {
- $_ = $fn;
- if (! -d $fn && ! /\/$/) {
- print STDERR "$fn: not a regular file, or insecure ownership and permissions. Skipped\n";
- }
- }
- }
- }
- }
- }
- if ($current_best_file) {
- return $current_best_file;
- }
- # Yikes! Cannot find a valid PPD file!
- return undef;
- }
-
- # Return default type, options, resolutions, and default values.
- # More efficient since it takes only one pass over the data.
- sub get_ppd_data(*$$$$$) {
- my ($fh, $types, $opts, $resolutions, $defaults, $data) = @_;
- my (%options, %defaults, %resolution_map, %default_types);
- my $cur_opt = "";
- my (@optionlist);
- my ($source_data) = "";
- if ($reset_defaults) {
- $types = 0;
- $opts = 0;
- $resolutions = 0;
- $defaults = 0;
- }
-
- if ($resolutions || $types || $opts || $defaults || $data) {
- while (<$fh>) {
- last if $_ eq "*%*%EOFEOF\n";
- $source_data .= $_ if ($data);
- chomp;
- if (($types || $opts) && m/^\*OpenUI/) {
- my ($key, $value) = /^\*OpenUI\s\*([[:alnum:]]+).*:\s([[:alnum:]]+)/;
- if ($key && $value) {
- $default_types{$key}=$value;
- $cur_opt = $key;
- }
- } elsif ($opts && m/^\*CloseUI/) {
- if ($cur_opt ne "") {
- $options{$cur_opt} = [ @optionlist ];
- $cur_opt = "";
- }
- @optionlist = ();
- } elsif ($opts && m/^\*$cur_opt/) {
- my ($value) = /^\*$cur_opt\s*([[:alnum:]]+)[\/:]/;
- if (defined $value && $value) {
- push @optionlist, $value;
- }
- } elsif ($resolutions && m/^\*StpResolutionMap:/) {
- my ($junk, $new, $old) = split;
- $resolution_map{$old} = $new;
- } elsif ($defaults && m/^\*Default/) {
- my($key, $value) = /^\*([[:alnum:]]+):\s*([[:alnum:]]+)/;
- if ($key && $value) {
- $defaults{$key}=$value;
- }
- }
- }
- }
- return (\%default_types, \%options, \%resolution_map, \%defaults, $source_data);
- }
-